home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s2.arc / PIB4010B.MOD < prev    next >
Text File  |  1987-05-25  |  13KB  |  393 lines
  1. (*----------------------------------------------------------------------*)
  2. (*          Scroll_Up --- Handle graphics screen scroll                 *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE ScrollUp;
  6.  
  7. BEGIN (* ScrollUp *)
  8.  
  9.    IF LeftH THEN
  10.       BEGIN
  11.          LeftH := FALSE;
  12.          Graphics_XPos := 320;
  13.       END
  14.    ELSE
  15.       BEGIN
  16.          LeftH := TRUE;
  17.          Graphics_XPos := 0;
  18.       END;
  19.  
  20.    Graphics_YPos := 5;
  21.  
  22. END   (* ScrollUp *);
  23.  
  24. (*----------------------------------------------------------------------*)
  25. (*           Handle_Escape_Sequence --- Handle escape sequence          *)
  26. (*----------------------------------------------------------------------*)
  27.  
  28. PROCEDURE Handle_Escape_Sequence;
  29.  
  30. VAR
  31.    Ch: CHAR;
  32.  
  33. (*----------------------------------------------------------------------*)
  34.  
  35. FUNCTION Async_Next_Character : CHAR;
  36.  
  37. VAR
  38.    C:  INTEGER;
  39.  
  40. BEGIN (* Async_Next_Character *)
  41.  
  42.    Async_Receive_With_Timeout( 5 , C );
  43.  
  44.    IF ( C <> TimeOut ) THEN
  45.       Async_Next_Character := CHR( C )
  46.    ELSE
  47.       Async_Next_Character := CHR(0);
  48.  
  49. END   (* Async_Next_Character *);
  50.  
  51. (*----------------------------------------------------------------------*)
  52.  
  53. BEGIN (* Handle_Escape_Sequence *)
  54.  
  55.    CASE Async_Next_Character OF
  56.  
  57.       '/':      BEGIN
  58.                    IF Async_Next_Character IN ['0'..'2'] THEN
  59.                       IF Async_Next_Character = 'd' THEN;
  60.                 END;
  61.  
  62.       '8','9',':',';','?','''': ;
  63.  
  64.       'a'..'z': ;
  65.  
  66.       '"':      BEGIN
  67.                    IF Async_Next_Character IN ['0'..'7'] THEN
  68.                       IF Async_Next_Character IN ['e','g'] THEN;
  69.                 END;
  70.  
  71.       Ch_FF:    BEGIN
  72.                    Clear_Graphics_Screen;
  73.                    FlagG := Text_Plot;
  74.                 END;
  75.  
  76.       Ch_FS:   FlagG := Point_Plot_Start;
  77.  
  78.       Ch_GS:   FlagG := Vector_Plot_Start;
  79.  
  80.       ELSE;
  81.  
  82.    END (* CASE *);
  83.  
  84. END   (* Handle_Escape_Sequence *);
  85.  
  86. (*----------------------------------------------------------------------*)
  87.  
  88. BEGIN (* Display_Graphics *)
  89.                                    (* Remove current cursor       *)
  90.  
  91.    Display_Cursor( CursorX, CursorY );
  92.  
  93.                                    (* Select display depending on *)
  94.                                    (* character.                  *)
  95.    C := ORD( Ch );
  96.  
  97.    IF ( FlagG = Text_Plot ) THEN
  98.       CASE C OF
  99.  
  100.          NUL  :    ;       (* Strip Nulls              *)
  101.          DEL  :    ;       (* Strip Deletes            *)
  102.  
  103.          ESC  :    Handle_Escape_Sequence;
  104.  
  105.          BS   :    BEGIN
  106.                       IF LeftH THEN
  107.                          Graphics_XPos := MAX( Graphics_Xpos - 8 , 0 )
  108.                       ELSE
  109.                          Graphics_XPos := MAX( Graphics_Xpos - 8 , 320 );
  110.                    END;
  111.  
  112.          BELL :    IF Not Silent_Mode THEN
  113.                       WRITE( Ch );
  114.  
  115.          HT   :    BEGIN
  116.  
  117.                       L := 9 - WhereX MOD 8;
  118.  
  119.                       FOR I := 1 TO L DO
  120.                          BEGIN
  121.                             Plot_Char( BL_Ch, Graphics_XPos, Graphics_YPos );
  122.                             Graphics_XPos := Graphics_XPos + 8;
  123.                          END;
  124.  
  125.                    END;
  126.  
  127.          FF   :    Clear_Graphics_Screen;
  128.  
  129.          CR   :    IF Add_LF THEN
  130.                       BEGIN
  131.                          Graphics_YPos := Graphics_YPos + 6;
  132.                          Last_Column_Hit := FALSE;
  133.                          IF Graphics_YPos > 198 THEN
  134.                             ScrollUp
  135.                          ELSE IF LeftH THEN
  136.                             Graphics_XPos := 0
  137.                          ELSE
  138.                             Graphics_XPos := 320;
  139.                       END
  140.                    ELSE
  141.                       BEGIN
  142.                          IF LeftH THEN
  143.                             Graphics_XPos := 0
  144.                          ELSE
  145.                             Graphics_XPos := 320;
  146.                          Last_Column_Hit := FALSE;
  147.                       END;
  148.  
  149.  
  150.          LF   :    IF NOT Add_LF THEN
  151.                       BEGIN
  152.                          Graphics_YPos := Graphics_YPos + 6;
  153.                          IF Graphics_YPos > 198 THEN
  154.                             ScrollUp;
  155.                       END;
  156.  
  157.          VT   :    IF ( Graphics_YPos > 6 ) THEN
  158.                       Graphics_YPos := Graphics_YPos - 6;
  159.  
  160.          FS   :    FlagG := Point_Plot_Start;
  161.  
  162.          GS   :    FlagG := Vector_Plot_Start;
  163.  
  164.          ELSE
  165.             IF ( C > 31 ) THEN
  166.                BEGIN
  167.                   Plot_Char( Ch, Graphics_XPos, Graphics_YPos );
  168.                   Graphics_XPos := Graphics_XPos + 8;
  169.                   IF ( Graphics_XPos >= 640 ) THEN
  170.                      BEGIN
  171.                         Graphics_XPos := 0;
  172.                         Graphics_YPos := Graphics_YPos + 6;
  173.                         IF Graphics_YPos > 198 THEN
  174.                            ScrollUp;
  175.                      END;
  176.  
  177.                END;
  178.  
  179.       END (* CASE *)
  180.  
  181.    ELSE                            (* Graphics mode *)
  182.  
  183.       CASE C OF
  184.  
  185.          FF:      BEGIN
  186.                      Clear_Graphics_Screen;
  187.                      FlagG := Text_Plot;
  188.                   END;
  189.  
  190.          CR:      BEGIN
  191.                      IF LeftH THEN
  192.                         Graphics_XPos := 0
  193.                      ELSE
  194.                         Graphics_XPos := 320;
  195.                      Last_Column_Hit := FALSE;
  196.                      FlagG := Text_Plot;
  197.                   END;
  198.  
  199.          FS:      FlagG := Point_Plot_Start;
  200.  
  201.          GS:      FlagG := Vector_Plot_Start;
  202.  
  203.          US:      FlagG := Text_Plot;
  204.  
  205.          ESC:     Handle_Escape_Sequence;
  206.  
  207.          ELSE
  208.             IF C > 31 THEN
  209.                Do_Graphics;
  210.  
  211.       END (* CASE *);
  212.                                    (* Display cursor *)
  213.  
  214.    Display_Cursor( Graphics_XPos, Graphics_YPos );
  215.  
  216.    CursorX := Graphics_XPos;
  217.    CursorY := Graphics_YPos;
  218.  
  219. END   (* Display_Graphics *);
  220.  
  221. (*----------------------------------------------------------------------*)
  222. (*  Initialize_Graphics_Mode --- Initialize for CGA/EGA differences     *)
  223. (*----------------------------------------------------------------------*)
  224.  
  225. PROCEDURE Initialize_Graphics_Mode;
  226.  
  227. (*----------------------------------------------------------------------*)
  228. (*                                                                      *)
  229. (*     Procedure:  Initialize_Graphics_Mode                             *)
  230. (*                                                                      *)
  231. (*     Purpose:    Set up graphics mode for CGA/EGA differences         *)
  232. (*                                                                      *)
  233. (*     Calling Sequence:                                                *)
  234. (*                                                                      *)
  235. (*        Initialize_Graphics_Mode;                                     *)
  236. (*                                                                      *)
  237. (*----------------------------------------------------------------------*)
  238.  
  239. BEGIN (* Initialize_Graphics_Mode *)
  240.  
  241.                                    (* Determine if EGA installed       *)
  242.    EGA_On := EGA_Present;
  243.                                    (* Set up depending upon EGA or CGA *)
  244.    IF EGA_On THEN
  245.       BEGIN
  246.          XFactor         := 0.625;
  247.          YFactor         := 0.2564103;
  248.          YMax            := 199;
  249.          YInc            := 6;
  250.          GMode           := 6;
  251. {
  252.          Plot_Point_Addr := OFS( Plot_Point_EGA );
  253.          XOR_Point_Addr  := OFS( XOR_Point_EGA  );
  254. }
  255.          Set_EGA_Text_Mode( 25 );
  256.  
  257.       END
  258.    ELSE
  259.       BEGIN
  260.          XFactor         := 0.625;
  261.          YFactor         := 0.2564103;
  262.          YMax            := 199;
  263.          YInc            := 6;
  264.          GMode           := 6;
  265. {
  266.          Plot_Point_Addr := OFS( Plot_Point_CGA );
  267.          XOR_Point_Addr  := OFS( XOR_Point_CGA  );
  268. }
  269.       END;
  270.  
  271.    YMaxM1 := YMax - 1;
  272.  
  273.    CASE MultiTasker OF
  274.       DoubleDos:  Graphics_Screen := DesqView_Screen;
  275.       ELSE        Graphics_Screen := Actual_Screen;
  276.    END (* CASE *);
  277.  
  278. END   (* Initialize_Graphics_Mode *);
  279.  
  280. (*----------------------------------------------------------------------*)
  281.  
  282. BEGIN (* Emulate_TEK4010 *)
  283.                                    (* Initialize error handler. *)
  284.    ErrorPtr := OFS( Trap_Error );
  285.  
  286.                                    (* Initialize *)
  287.    Graphics_Terminal_Mode := TRUE;
  288.    Auto_Wrap_Mode         := TRUE;
  289.    Done                   := FALSE;
  290.    Do_Status_Line         := FALSE;
  291.    Do_Status_Time         := FALSE;
  292.    FlagG                  := Text_Plot;
  293.    New_Line               := FALSE;
  294.    Insertion_Mode         := FALSE;
  295.    Save_SUpper            := Send_Upper_Case_Only;
  296.    Send_Upper_Case_Only   := TRUE;
  297.    Do_Script_Tests        := Waitstring_Mode OR When_Mode OR
  298.                              WaitCount_Mode  OR WaitQuiet_Mode OR
  299.                              Script_Learn_Mode;
  300.  
  301.                                    (* Load function keys             *)
  302.    IF Auto_Load_FunKeys THEN
  303.       Load_Function_Keys( 'TEK4010.FNC' );
  304.  
  305.    Graphics_ForeGround_Color := Global_ForeGround_Color;
  306.    Graphics_BackGround_Color := Global_BackGround_Color;
  307.  
  308.                                    (* Set up depending upon EGA/CGA *)
  309.    Initialize_Graphics_Mode;
  310.                                    (* Clear graphics screen      *)
  311.    Clear_Graphics_Screen;
  312.    Display_Cursor( CursorX, CursorY );
  313.  
  314.                                    (* Loop over input until done *)
  315.    WHILE ( NOT Done ) DO
  316.       BEGIN
  317.                                    (* Check for character typed at keyboard *)
  318.          IF KeyPressed THEN
  319.             BEGIN
  320.                Handle_Keyboard_Input( Done , Reset_Requested ,
  321.                                       ClrScr_Req );
  322.                Do_Status_Line  := FALSE;
  323.                Do_Status_Time  := FALSE;
  324.                IF Reset_Requested THEN
  325.                   BEGIN
  326.                      Clear_Graphics_Screen;
  327.                      Display_Cursor( CursorX, CursorY );
  328.                      FlagG := Text_Plot;
  329.                   END
  330.                ELSE IF ClrScr_Req THEN
  331.                   BEGIN
  332.                      Clear_Graphics_Screen;
  333.                      Display_Cursor( CursorX, CursorY );
  334.                   END;
  335.             END;
  336.                                    (* Process any script in progress *)
  337.  
  338.          IF ( Script_File_Mode AND ( NOT ( Done OR Really_Wait_String ) ) ) THEN
  339.             BEGIN
  340.                Get_Script_Command( PibTerm_Command );
  341.                Execute_Command   ( PibTerm_Command , Done , TRUE );
  342.             END;
  343.                                    (* Handle carrier drop *)
  344.          IF Carrier_Dropped THEN
  345.             Handle_Carrier_Drop;
  346.                                    (* Hold everything while scroll lock on *)
  347.  
  348.          IF Scroll_Lock_On THEN
  349.             Handle_Scroll_Lock;
  350.  
  351.                                    (* Process character from remote *)
  352.  
  353.          IF ( Async_Buffer_Head <> Async_Buffer_Tail ) THEN
  354.             BEGIN
  355.                                    (* Get the character *)
  356.  
  357.                B := Async_Receive( Ch );
  358.  
  359.                                    (* Strip high bit if requested *)
  360.  
  361.                IF Auto_Strip_High_Bit THEN
  362.                   Ch := CHR( ORD( Ch ) AND $7F );
  363.  
  364.                                    (* Perform translation *)
  365.  
  366.                Ch := TrTab[Ch];
  367.  
  368.                                    (* Display the character received *)
  369.  
  370.                Display_Graphics( Ch );
  371.  
  372.                IF Do_Script_Tests THEN
  373.                   Do_Script_Checks( Ch );
  374.  
  375.             END
  376.                                    (* Check if waitstring time exhausted *)
  377.          ELSE
  378.             BEGIN
  379.                Async_Line_Status := Async_Line_Status AND $FD;
  380.                IF Really_Wait_String THEN
  381.                   Check_Wait_String_Time;
  382.                IF ( ( NOT KeyPressed ) AND ( NOT Script_File_Mode ) ) THEN
  383.                   IF ( Async_Buffer_Head = Async_Buffer_Tail ) THEN
  384.                      GiveAwayTime( 1 );
  385.             END;
  386.  
  387.       END;
  388.  
  389.    Graphics_Terminal_Mode := FALSE;
  390.    Send_Upper_Case_Only   := Save_SUpper;
  391.  
  392. END   (* Emulate_TEK4010 *);
  393.